;;; -*- mode: lisp -*-

(in-package "MUDRA-TEST")


;;;; Bits and Pieces

(defvar *random-text*
  "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Quisque iaculis, nulla id semper faucibus, pede tellus nonummy magna, vitae adipiscing orci arcu ut augue. Nunc condimentum, magna a vestibulum convallis, libero purus pulvinar orci, sed vestibulum urna sem ut pede.
More Ipsum...

Sed sollicitudin suscipit risus. Nam ullamcorper. Sed nisl lectus, pellentesque nec, malesuada eget, ornare a, libero. Lorem ipsum dolor sit amet, consectetuer adipiscing elit.")

(defparameter *states-alist*
  '(("AL" . "Alabama")

    ("AK" . "Alaska")
    ("AS" . "American Samoa")
    ("AZ" . "Arizona")
    ("AR" . "Arkansas")
    ("AE" . "Armed Forces Europe")
    ("AP" . "Armed Forces Pacific")
    
    ("AA" . "Armed Forces the Americas")
    ("CA" . "California")
    ("CO" . "Colorado")
    ("CT" . "Connecticut")
    ("DE" . "Delaware")
    ("DC" . "District of Columbia")
    
    ("FM" . "Federated States of Micronesia")
    ("FL" . "Florida")
    ("GA" . "Georgia")
    ("GU" . "Guam")
    ("HI" . "Hawaii")
    ("ID" . "Idaho")
    
    ("IL" . "Illinois")
    ("IN" . "Indiana")
    ("IA" . "Iowa")
    ("KS" . "Kansas")
    ("KY" . "Kentucky")
    ("LA" . "Louisiana")
    
    ("ME" . "Maine")
    ("MH" . "Marshall Islands")
    ("MD" . "Maryland")
    ("MA" . "Massachusetts")
    ("MI" . "Michigan")
    ("MN" . "Minnesota")
    
    ("MS" . "Mississippi")
    ("MO" . "Missouri")
    ("MT" . "Montana")
    ("NE" . "Nebraska")
    ("NV" . "Nevada")
    ("NH" . "New Hampshire")
    
    ("NJ" . "New Jersey")
    ("NM" . "New Mexico")
    ("NY" . "New York")
    ("NC" . "North Carolina")
    ("ND" . "North Dakota")
    ("MP" . "Northern Mariana Islands")
    
    ("OH" . "Ohio")
    ("OK" . "Oklahoma")
    ("OR" . "Oregon")
    ("PA" . "Pennsylvania")
    ("PR" . "Puerto Rico")
    ("RI" . "Rhode Island")
    
    ("SC" . "South Carolina")
    ("SD" . "South Dakota")
    ("TN" . "Tennessee")
    ("TX" . "Texas")
    ("UT" . "Utah")
    ("VT" . "Vermont")

    ("VI" . "Virgin Islands, U.S.")
    ("VA" . "Virginia")
    ("WA" . "Washington")
    ("WV" . "West Virginia")
    ("WI" . "Wisconsin")
    ("WY" . "Wyoming")))

;;;; The Test Pages

(def-test-page tbd ()
  '(p "This is TBD"))

(def-test-page minimal ()
  (note-css '(.foo 
	      :background-color "yellow"
	      :margin "3cm"
	      :padding "1cm"
	      :frame "1cm"))
  '((p :class "foo") 
    "Minimal, but ugly!"))

(def-test-page tab-container-test ()
  (note-dojo-requirement "dojo.widget.ContentPane")
  (note-dojo-requirement "dojo.widget.TabContainer")
  '((dojo-tab-container :id "main" :selected-tab "a" :style "width: 100%; height: 100%")
    ((dojo-content-pane :id "a" :label "Greek") (p "alpha"))
    ((dojo-content-pane :id "b" :label "Fruit") (p "banana"))
    ((dojo-content-pane :id "c" :label "Status") (p "chaos"))
    ((dojo-content-pane :id "d" :label "Action") (p "dance"))))

(def-test-page split-container-test ()
  (note-dojo-requirement "dojo.widget.ContentPane")
  (note-dojo-requirement "dojo.widget.SplitContainer")
  '((dojo-split-container :orientation "horizontal" :style "width: 100%; height: 100%" :sizer-width 5)
    ((dojo-content-pane :id "1" :size-share "30" :style "background: yellow") (p "Art"))
    ((dojo-split-container :orientation "vertical" :style "width: 100%; height: 100%")
     ((dojo-content-pane :id "2" :size-share "40" :style "background: red") (p "Drag Dividers"))
     ((dojo-content-pane :id "3" :size-share "60" :style "background: blue") (p "dance")))))

(def-test-page accordion-container-test ()
  (note-dojo-requirement "dojo.widget.ContentPane")
  (note-dojo-requirement "dojo.widget.AccordionContainer")
  (note-css '(.label 
	      :background "gray"
	      :border-top "1px solid black"
	      :border-bottom "1px solid black"
	      :color "lightblue"))
  (note-css '(.content :background "snow" :top-margin 0))
  '((dojo-accordion-container 
     :toggle "fade"
     :id "main"
     :selected-tab "a"
     :label-node-class "label"
     :container-node-class "content"
     :style "width: 200px; height: 3in; border: 2px solid black")
    ((dojo-content-pane :id "a" :label "Greek" :open "true")
     (p "alpha, beta, gama")
     (p "Athens, Volos, Andros"))
    ((dojo-content-pane :id "b" :label "Fruit") (p "banana, duran, passion"))
    ((dojo-content-pane :id "c" :label "Status") (p "chaos, finished, started, abandoned"))
    ((dojo-content-pane :id "d" :label "Action") (p "dance, sleep, nap, eat"))))

(def-test-page layout-container-test ()
  (note-dojo-requirement "dojo.widget.ContentPane")
  (note-dojo-requirement "dojo.widget.LayoutContainer")
  (flet ((dcp (align color)
	   `(dojo-content-pane 
	     :layout-align ,align
	     :style ,(format nil "border: 1px solid ~A" color))))
  `((dojo-layout-container
     :id "main"
     :layout-child-priority "top-bottom"
     :style "width: 100%; height: 100%; border: 2px solid black")
    (,(dcp  "top" "brown") (p "Header"))
    (,(dcp  "bottom" "orange") (p "footer"))
    ((dojo-layout-container 
      :layout-align "client" :style "border 1px solid blue"
      :layout-child-priority "left-right")
     (,(dcp  "right" "yellow") (p "right gutter"))
     (,(dcp   "left"    "red") (p "left gutter"))
     (,(dcp "client"  "green") (p "body"))))))

(def-test-page content-pane-test ()
  (note-dojo-requirement "dojo.widget.ContentPane")
  `((dojo-content-pane :style "border: 1px solid red; background: snow; padding: 4px")
    (p "ContentPanes get refined into more interesting things.")))

(def-test-page title-pane-test ()
  (note-dojo-requirement "dojo.widget.TitlePane")

  (note-css '(.label 
	      :background "gray"
	      :border-top "1px solid black"
	      :border-bottom "1px solid black"
	      :color "lightblue"))
  (note-css '(.content :background "snow" :margin 0))

  `((dojo-title-pane :label "Click Me, Please"
     :label-node-class "label"
     :container-node-class "content")
    (p ,*random-text*)))

(def-test-page floating-pane-test ()
  (note-dojo-requirement "dojo.widget.FloatingPane")

  `((dojo-floating-pane
     :title "I'm Floating!"
     :constrain-to-container "true"
     :has-shadow "true"
     :resizable "true" 
     :window-state "normal"
     :display-close-action "true"
     :display-minimize-action "true"
     :display-maximize-action "true"
     :toggle "explode"
     :style "width: 300px; height: 400px; left: 5px; top: 15px;"
     :constrain-to-container "true")
    (p ,*random-text*)))



(def-test-page simple-button-test ()
  (note-dojo-requirement "dojo.widget.ContentPane")
  (note-dojo-requirement "dojo.widget.LayoutContainer")
  (note-dojo-requirement "dojo.widget.Button")

  (flet ((click-a-roo (x)
	   (js:js-inline*
	    `((slot-value (dojo.widget.by-id "result") 'set-content) ,x))))

  `((dojo-layout-container
     :layout-child-priority "top-bottom"
     :style "width: 70%; height: 70%; border: 2px solid black")
    ((dojo-content-pane :id "result" :layout-align "bottom" :style "border-top: 1px solid black; padding: 4px")
     "Results appear here.")

    ((dojo-content-pane 
      :layout-align "client" 
      :style "padding: 10px")
     ((dojo-button :on-click ,(click-a-roo "yes, it's is so very OK!")) 
      "OK")
     ((dojo-button :on-click ,(click-a-roo "Dude?")) 
      "Nope"))

    )))


(def-test-page menu-test ()
  (note-dojo-requirement "dojo.widget.ContentPane")
  (note-dojo-requirement "dojo.widget.LayoutContainer")
  (note-dojo-requirement "dojo.widget.Button")
  (note-dojo-requirement "dojo.widget.Menu2")

  (flet ((click-a-roo (x)
	   (js:js-inline*
	    `((slot-value (dojo.widget.by-id "result") 'set-content) ,x))))

  `((dojo-layout-container
     :layout-child-priority "top-bottom"
     :style "width: 70%; height: 70%; border: 2px solid black")
    ((dojo-content-pane :id "result" :layout-align "bottom" :style "border-top: 1px solid black; padding: 4px")
     "Results appear here.")

    ((dojo-content-pane 
      :layout-align "client" 
      :style "padding: 10px")

     ((dojo-popup-menu2 :id "menu1" :toggle "wipe")
      ((dojo-menu-item2 :caption "Pop" :accel-key "Ctrl+P"
	    :on-click ,(click-a-roo "pop")))      
      ((dojo-menu-item2 :caption "Bang" :accel-key "Ctrl+B"
	    :on-click ,(click-a-roo "bang")))      
      ((dojo-menu-item2 :caption "Zing" :accel-key "Ctrl+Z"
	    :on-click ,(click-a-roo "Zing"))))

     ((dojo-dropdown-button :menu-id "menu1") "Cartoon")))))

(def-test-page tree-test ()
  (note-dojo-requirement "dojo.widget.ContentPane")
  (note-dojo-requirement "dojo.widget.DocPane")
  (note-dojo-requirement "dojo.widget.Tree")
  (note-dojo-requirement "dojo.widget.TreeSelector")
  (sexpr->dojo-tree 
     '(("letters" "a" "b" "c")
       ("fruit" "apple" "banana" "cantalop")
       ("fruit" "apple" "banana" "cantalop")
       ("parts" 
	("noun" "cat" "truth")
	("verb" "run" "assess")
	("adjective" "blue" "heavy")))))


(def-test-page combobox-test ()
  (note-dojo-requirement "dojo.widget.ComboBox")
  (flet ((selection-options-from-alist (alist)
	   (loop for (k . v) in alist collect `((option :value ,k) ,v))))
  `((form :action "#" :method "GET")
    (p "Combobox, no autocomplete, inlined data, let it pick default value.")
    ((dojo-combobox :style "width: 300px" :name "combobox1" :autocomplete "false")
    ,@(selection-options-from-alist *states-alist*))
    (hr)
    (p "Combobox, autocomplete, inlined data, set default to empty string.")
    ((dojo-combobox :style "width: 300px" :name "combobox1" :autocomplete "True" :value "")
    ,@(selection-options-from-alist *states-alist*))
    (p "BROKEN, the default's not right")
    (hr)
    (p "Missing tests for fetching data, rather than inline data."))))

(def-test-page home ()

  (note-dojo-requirement "dojo.widget.SplitContainer")
  (note-dojo-requirement "dojo.widget.ContentPane")
  (note-dojo-requirement "dojo.widget.DocPane")
  (note-dojo-requirement "dojo.widget.Tree")
  (note-dojo-requirement "dojo.widget.TreeSelector")

  (note-javascript
     '(defun *display-tree-content ()
       (setf this.update
	     (lambda (message)
	       (let ((clicked-tree-node message.node)
		     (doc-pane (dojo.widget.by-id "view"))
		     (url clicked-tree-node.object))
		 (if url
		     (doc-pane.set-url url)
		     (doc-pane.set-content (html (:p "Select a leaf for individual examples")))))))))

  (note-javascript
     '(let ((displayer (new (*display-tree-content)))
	   (node-selection-topic
	    (dojo.event.topic.get-topic "nodeSelected")))
       (node-selection-topic.subscribe displayer "update")))

  (flet ((split (left right)
	   `((dojo-split-container 
	      :orientation "horizontal"
	      :sizer-width 3
	      :style "width: 100%; height: 100%")
	     ((dojo-split-container 
	      :orientation "vertical"
	      :size-share "25"
	      :sizer-width 3
	      :style "width: 100%; height: 100%")
	      ((dojo-content-pane :id "select" :size-share 70 :style "overflow-y: scroll")
	       ,left)
	      ((dojo-content-pane :size-share 30)
	       ((dojo-debug :style "overflow-y: scroll; width: 100%; height: 100%") (p "Debugging..."))))
	     ((dojo-content-pane :id "view" :size-share "75" :style "margin: 20px")
	      ,right)))

	 (tree-selector ()
	   (flet ((dtn (name page)
		    `((dojo-tree-node 
		       :title ,name
		       :object ,(format nil "~(~A~)" page)))))
	   `(div
	     ((dojo-tree-selector
	       :event-names "select:nodeSelected"
	       :widget-id "eventHub"))
	     ((dojo-tree :style "height: 100%" :selector "eventHub" :expand-level 4)
	     ((dojo-tree-node :title "Containers")
	      ,(dtn "Tab Container" 'tab-container-test)
	      ,(dtn "Split Container" 'split-container-test)
	      ,(dtn "Accordion Container" 'accordion-container-test)
	      ,(dtn "Layout Container" 'layout-container-test))
	     ((dojo-tree-node :title "Panes")
	      ,(dtn "Content Pane" 'content-pane-test)
	      ,(dtn "Title Pane" 'title-pane-test)
	      ,(dtn "Floating Pane" 'floating-pane-test)
	      ,(dtn "Doc Pane" 'tbd))
	     ((dojo-tree-node :title "Widgets")
	      ,(dtn "Simple Button" 'simple-button-test)
	      ,(dtn "Menu" 'menu-test)
	      ,(dtn "Combobox" 'combobox-test)
	      ,(dtn "Tree Widget" 'tree-test))))))

	 (content-region ()
	   '(p "TBD")))

    (split (tree-selector) (content-region))))
